home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-20 / nrd34.zip / NRDIO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-01  |  27KB  |  1,011 lines

  1. {$I-}
  2. {$V-}
  3.  
  4. unit nrdio;
  5.  
  6. interface
  7.  
  8. const DATELEN     = 6;
  9.       TIMELEN     = 4;
  10.       LONGSTRLEN  = 255;
  11.       MEDSTRLEN   = 80;
  12.       SHORTSTRLEN = 8;
  13.       CALLSIGNLEN = 19;
  14.       LOCATIONLEN = 27;
  15.       COMMENTLEN  = 69;
  16.       MAXREC      = 2500; { maximum records in a log }
  17.       MAXLOGS     = 15;
  18.  
  19.       PATH        = '';
  20.       LOGFILE     = 'LOG';
  21.       RECFILE     = 'REC';
  22.       RECDATAFILE = 'RECDAT';
  23.       LOGLISTFILE = 'LOGLIST.DAT';
  24.  
  25.       FILE_NOT_FOUND = 2;
  26.  
  27.       REMOTE_DLY = 300; { msec }
  28.  
  29. type  longstr       = string[LONGSTRLEN];
  30.       datetype      = string[DATELEN];
  31.       timetype      = string[TIMELEN];
  32.       calltype      = string[CALLSIGNLEN];
  33.       locationtype  = string[LOCATIONLEN];
  34.       commenttype   = string[COMMENTLEN];
  35.  
  36.       modetype      = (RTTY, CW, USB, LSB, AM, FM, FAX, ECSS_USB, ECSS_LSB);
  37.       bandwidthtype = (NARR, INTER, WIDE, AUX);
  38.       agctype       = (OFF, FAST, SLOW);
  39.       attentype     = (NO, YES);
  40.       rectype       = (SHOW, HIDE, DELETED);
  41.  
  42.       logtype = record
  43.                   date:       datetype;
  44.                   begin_time,
  45.                   end_time:   timetype;
  46.                   frequency:  real;
  47.                   callsign:   calltype;
  48.                   location:   locationtype;
  49.                   comment:    commenttype;
  50.                   mode:       modetype;
  51.                   bandwidth:  bandwidthtype;
  52.                   agc:        agctype;
  53.                   attenuator: attentype;
  54.                 end;
  55.  
  56.       recarraytype = packed array[1..MAXREC] of 0..MAXREC;
  57.  
  58.       recdatatype = packed record
  59.                   recptr:   recarraytype;
  60.                   m7000ptr: recarraytype; { not used }
  61.                   recstat:  packed array[1..MAXREC] of rectype;
  62.                 end;
  63.  
  64.       short_str = string[SHORTSTRLEN];
  65.  
  66.       sort_array_type = array[1..MAXREC] of short_str;
  67.  
  68.       journaltype = record
  69.                   logname:  short_str;
  70.                   records,
  71.                   rec:      integer;
  72.                 end;
  73.  
  74.       loglisttype = record
  75.                   logcount,
  76.                   currentlog: byte;
  77.                   log:         array[1..MAXLOGS] of journaltype;
  78.                 end;
  79.  
  80.       configtype = record
  81.                   com_port:byte;
  82.                   receiver_type:word;
  83.                   has_map:boolean;
  84.                   time_offset:byte;
  85.                 end;
  86.  
  87.       receivertype = record
  88.                   channel:    byte;
  89.                   frequency:  real;
  90.                   mode:       modetype;
  91.                   bandwidth:  bandwidthtype;
  92.                   agc:        agctype;
  93.                   attenuator: attentype;
  94.                 end;
  95.  
  96.   var recbuf, recdatabuf, loglistbuf, logbuf:file;
  97.       recdata:recdatatype;
  98.       records:integer;     { total number of records }
  99.       loglist:loglisttype;
  100.       rec:integer;
  101.       receiverstat:receivertype;
  102.       has_map:boolean;
  103.       com_nrd:byte;
  104.       radio_type:word;
  105.       gmt_offset:byte;
  106.       old_time_str:string;
  107.       day_str,mon_str,year_str,time_str:string;
  108.       old_time_stamp:longint;
  109.  
  110.  
  111.   procedure get_records(var records:integer);
  112.   procedure put_records(records:word);
  113.   procedure get_recdata(thelog:byte; var recdata:recdatatype);
  114.   procedure put_recdata(thelog:byte; recdata:recdatatype);
  115.   procedure time_date_stamp(var mon_str:string; var day_str:string;
  116.                             var yr_str:string; var time_str:string;
  117.                             force:boolean);
  118.   procedure clear_log(var logdata:logtype);
  119.   procedure open_log(var logbuf: file; thelog:byte; var rslt:integer);
  120.   procedure get_log(var logbuf:file; var logdata:logtype; rec:integer);
  121.   procedure put_log(var logbuf:file; logdata:logtype; rec:integer);
  122.   procedure get_loglist(var loglist:loglisttype);
  123.   procedure put_loglist(loglist:loglisttype);
  124.   procedure init_com; { open com and set up for session }
  125.   procedure write_com(port:byte; s:string);
  126.   procedure comreadln(port:byte; var s:string);
  127.   procedure remote_on;{ enable remote control of radio, get receiver status }
  128.   procedure remote_off(dly:word);
  129.   procedure toggle_remote;
  130.   procedure check_status(var s:string);
  131.   procedure set_freq(frequency:real);
  132.   procedure set_mode(mode:modetype);
  133.   procedure set_bandwidth(bandwidth:bandwidthtype);
  134.   procedure set_agc(agc:agctype);
  135.   procedure set_attenuator(attenuator:attentype);
  136.   procedure set_bwc(s:string); { set NRD535 bandwidth control to "s" hz
  137.                       requires leading "0"  -- eg set_bwc('0500') for 500Hz}
  138.   procedure set_tuning_rate(s:string); { set NRD535 tuning rate
  139.                      '0' = 1Hz, '1' = 10Hz, '2' = 100Hz}
  140.   procedure set_auto_tune(s:string); { set NRD535 autotuning;
  141.                      '+' = Frequency up, '-' = Frequency down, '0' = stop }
  142.   procedure set_all(channel:byte; attenuator:attentype;
  143.                      bandwidth:bandwidthtype; mode:modetype; frequency:real;
  144.                      agc:agctype);
  145.   procedure information_mode_on;
  146.   procedure information_mode_off;
  147.   procedure check_s_meter(var reading:integer); { returns s_meter value
  148.                                                    converted to dB }
  149.   function get_s_reading:integer; { returns raw s_meter reading }
  150.  
  151.   implementation
  152.  
  153.   uses async, crt, dos, screen;
  154.  
  155.   procedure open_records(var rslt:integer);
  156.   var ch:char;
  157.   begin
  158.     assign(recbuf,PATH+RECFILE+'.DAT');
  159.     repeat
  160.       reset(recbuf,sizeof(records));
  161.       rslt:=ioresult;
  162.       if rslt = FILE_NOT_FOUND then
  163.         begin
  164.           rewrite(recbuf,sizeof(records));
  165.           records:=0;
  166.           blockwrite(recbuf,records,1);
  167.           close(recbuf);
  168.           reset(recbuf,sizeof(records));
  169.           rslt:=ioresult;
  170.         end;
  171.       hndlerr(FALSE,ch,rslt);
  172.     until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  173.   end;
  174.  
  175.   procedure get_records;
  176.   var ch:char;
  177.       rslt:integer;
  178.   begin
  179.     open_records(rslt);
  180.     if rslt = 0 then
  181.       begin
  182.         blockread(recbuf,records,1);
  183.         rslt:=ioresult;
  184.         hndlerr(FALSE,ch,rslt);
  185.       end;
  186.     close(recbuf);
  187.   end;
  188.  
  189.   procedure put_records;
  190.   var ch:char;
  191.       rslt:integer;
  192.   begin
  193.     open_records(rslt);
  194.     if rslt = 0 then
  195.       begin
  196.         blockwrite(recbuf,records,1);
  197.         rslt:=ioresult;
  198.         hndlerr(FALSE,ch,rslt);
  199.       end;
  200.     close(recbuf);
  201.   end;
  202.  
  203.   procedure open_recdata(thelog:byte; var rslt:integer);
  204.   var ch:char;
  205.       s:string;
  206.       i:integer;
  207.   begin
  208.     str(thelog,s);
  209.     if length(s) = 1 then s:='0' + s;
  210.     assign(recdatabuf,PATH+RECDATAFILE + s + '.DAT');
  211.     repeat
  212.       reset(recdatabuf,sizeof(recdata));
  213.       rslt:=ioresult;
  214.       if rslt = FILE_NOT_FOUND then
  215.         begin
  216.           for i:=1 to MAXREC do with recdata do
  217.             begin
  218.               if i <= records then
  219.                 begin
  220.                    recptr[i]:= i;
  221.                    recstat[i]:= SHOW
  222.                 end
  223.               else
  224.                 begin
  225.                   recptr[i]:=0;
  226.                   recstat[i]:=DELETED;
  227.                 end;
  228.               m7000ptr[i]:=0;
  229.             end;
  230.           rewrite(recdatabuf,sizeof(recdata));
  231.           blockwrite(recdatabuf,recdata,1);
  232.           close(recdatabuf);
  233.           reset(recdatabuf,sizeof(recdata));
  234.           rslt:=ioresult;
  235.         end;
  236.       hndlerr(FALSE,ch,rslt);
  237.     until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  238.   end;
  239.  
  240.   procedure get_recdata;
  241.  
  242.   var ch:char;
  243.       rslt:integer;
  244.   begin
  245.     open_recdata(thelog,rslt);
  246.     if rslt = 0 then
  247.       begin
  248.         blockread(recdatabuf,recdata,1);
  249.         rslt:=ioresult;
  250.         hndlerr(FALSE,ch,rslt);
  251.       end;
  252.     close(recdatabuf);
  253.   end;
  254.  
  255.   procedure put_recdata;
  256.  
  257.   var ch:char;
  258.       rslt:integer;
  259.   begin
  260.     open_recdata(thelog,rslt);
  261.     if rslt = 0 then
  262.       begin
  263.         blockwrite(recdatabuf,recdata,1);
  264.         rslt:=ioresult;
  265.         hndlerr(FALSE,ch,rslt);
  266.       end;
  267.     close(recdatabuf);
  268.   end;
  269.  
  270.   procedure time_date_stamp;
  271.   { takes a time reading if time has changed or force = TRUE }
  272.    var dy,yr,mo,dyofweek,hour,minute,sec,sec100:word;
  273.        t:string;
  274.        time_stamp:longint;
  275.   begin
  276.     gettime(hour,minute,sec,sec100);
  277.     time_stamp:=hour * 3600 + minute * 60 + sec;
  278.     if not force then if (time_stamp = old_time_stamp) then exit;
  279.     old_time_stamp:=time_stamp;
  280.     getdate(yr,mo,dy,dyofweek);
  281.     hour:=hour + gmt_offset;
  282.     if hour >= 24 then
  283.       begin
  284.         hour:=hour - 24;
  285.         dy:=dy + 1;
  286.         if dy > 31 then { kludge date, doesn't allow for 30 day mo, etc }
  287.           begin
  288.             dy:=1;
  289.             mo:=mo + 1;
  290.             if mo > 12 then mo:=1;
  291.           end;
  292.       end;
  293.     {init date to today's date in yymmdd format }
  294.     str(yr,t); delete(t,1,2);
  295.     yr_str:=t;
  296.     str(mo,t);
  297.     if length(t) < 2 then t:=concat('0',t);
  298.     mon_str:=t;
  299.     str(dy,t);
  300.     if length(t) < 2 then t:=concat('0',t);
  301.     day_str:=t;
  302.  
  303.     { init time in gmt }
  304.  
  305.     str(hour,t);
  306.     while length(t) < 2 do t:=concat('0',t);
  307.     time_str:=t;
  308.     str(minute,t);
  309.     while length(t) < 2 do t:=concat('0',t);
  310.     time_str:=concat(time_str,t);
  311.     str(sec,t);
  312.     while length(t) < 2 do t:=concat('0',t);
  313.     time_str:=concat(time_str,t);
  314.   end;
  315.  
  316.  
  317.   procedure clear_log;
  318.  
  319.   var day_str,mon_str,yr_str,time_str,t:string;
  320.   begin
  321.     time_date_stamp(mon_str,day_str,yr_str,time_str,TRUE);
  322.     with logdata do
  323.       begin
  324.         {init date to today's date in yymmdd format }
  325.         date:=yr_str + mon_str + day_str;
  326.  
  327.         { init time in gmt }
  328.         begin_time:=copy(time_str,1,4);
  329.         end_time:=begin_time;
  330.         frequency:= receiverstat.frequency;
  331.         callsign:=  '';
  332.         location:=  '';
  333.         comment:=   '';
  334.         mode:=      receiverstat.mode;
  335.         bandwidth:= receiverstat.bandwidth;
  336.         agc:=       receiverstat.agc;
  337.         attenuator:=receiverstat.attenuator;
  338.       end;
  339.   end;
  340.  
  341.   procedure open_log;
  342.  
  343.   var ch:char;
  344.       s:string;
  345.   begin
  346.     str(thelog,s);
  347.     if length(s) = 1 then s:='0'+s;
  348.     assign(logbuf,PATH+LOGFILE+s+'.DAT');
  349.     reset(logbuf,sizeof(logtype));
  350.     repeat
  351.       rslt:=IORESULT;
  352.       if rslt = FILE_NOT_FOUND then
  353.         begin
  354.           rewrite(logbuf,sizeof(logtype));
  355.           rslt:=ioresult;
  356.         end;
  357.       hndlerr(FALSE,ch,rslt);
  358.     until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  359.   end;
  360.  
  361.   procedure get_log;
  362.  
  363.   var rslt:integer;
  364.       ch:char;
  365.   begin
  366.     seek(logbuf,rec - 1);
  367.     blockread(logbuf,logdata,1);
  368.     rslt:=ioresult;
  369.     if rslt > 0 then
  370.       begin
  371.         hndlerr(TRUE,ch,rslt);
  372.         clear_log(logdata);
  373.         logdata.frequency:=0.0;
  374.         logdata.begin_time:='';
  375.         logdata.end_time:='';
  376.       end;
  377.   end;
  378.  
  379.   procedure put_log;
  380.  
  381.   var ch:char;
  382.       rslt:integer;
  383.  
  384.   begin
  385.     seek(logbuf,rec - 1);
  386.     blockwrite(logbuf,logdata,1);
  387.     rslt:=ioresult;
  388.     if rslt > 0 then
  389.       begin
  390.         hndlerr(TRUE,ch,rslt);
  391.       end;
  392.   end;
  393.  
  394.  
  395.  
  396.   procedure open_loglist(var rslt:integer);
  397.   var ch:char;
  398.   begin
  399.     assign(loglistbuf,PATH+LOGLISTFILE);
  400.     repeat
  401.       reset(loglistbuf,sizeof(loglisttype));
  402.       rslt:=ioresult;
  403.       if rslt = FILE_NOT_FOUND then
  404.         begin
  405.           rewrite(loglistbuf,sizeof(loglisttype));
  406.           loglist.logcount:=0;
  407.           blockwrite(loglistbuf,loglist,1);
  408.           close(loglistbuf);
  409.           reset(loglistbuf,sizeof(loglisttype));
  410.           rslt:=ioresult;
  411.         end;
  412.       hndlerr(FALSE,ch,rslt);
  413.     until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  414.   end;
  415.  
  416.   procedure get_loglist;
  417.  
  418.   var ch:char;
  419.       rslt:integer;
  420.   begin
  421.     open_loglist(rslt);
  422.     if rslt = 0 then
  423.       begin
  424.         blockread(loglistbuf,loglist,1);
  425.         if loglist.logcount = 0 then
  426.           begin
  427.             records:=0;
  428.             rec:=1;
  429.           end
  430.         else
  431.           begin
  432.             records:=loglist.log[loglist.currentlog].records;
  433.             rec:=    loglist.log[loglist.currentlog].rec;
  434.           end;
  435.         rslt:=ioresult;
  436.         hndlerr(FALSE,ch,rslt);
  437.       end;
  438.     close(loglistbuf);
  439.   end;
  440.  
  441.   procedure put_loglist;
  442.  
  443.   var ch:char;
  444.       rslt:integer;
  445.   begin
  446.     open_loglist(rslt);
  447.     if rslt = 0 then
  448.       begin
  449.         blockwrite(loglistbuf,loglist,1);
  450.         rslt:=ioresult;
  451.         hndlerr(FALSE,ch,rslt);
  452.       end;
  453.     close(loglistbuf);
  454.   end;
  455.  
  456.   procedure init_com; { open com and set up for session }
  457.   var baud:integer;
  458.   begin
  459.     if radio_type = 525 then baud:=1200 else
  460.     if radio_type = 535 then baud:=4800;
  461.     async_init;
  462.     if COM_NRD = 0 then exit;
  463.     if not async_open(COM_NRD,baud,'N',8,1) then
  464.       begin
  465.         writeln('Com port failure');
  466.         halt;
  467.       end;
  468.   end;
  469.  
  470.   procedure write_com;
  471.   begin
  472.     if COM_NRD = 0 then exit;
  473.     if radio_type = 535 then s:=s + chr(13);
  474.     async_send_string(s);
  475.   end;
  476.  
  477.   procedure comreadln;
  478.   var ch:char;
  479.       gotchar, done:boolean;
  480.       error_count:integer;
  481.   begin
  482.     s:='';
  483.     if COM_NRD = 0 then
  484.       begin
  485.         s:='000000';
  486.         exit;
  487.       end;
  488.     done:=FALSE;
  489.     error_count:=0;
  490.     while not done do
  491.       begin
  492.         gotchar:=async_buffer_check(ch);
  493.         if  not gotchar then
  494.           begin
  495.             delay(20);
  496.             inc(error_count);
  497.           end
  498.         else error_count:=0;
  499.         if error_count > 40 then exit;
  500.         done:=ch = #013;
  501.         if not done and gotchar then s:=s + ch;
  502.       end;
  503.   end;
  504.  
  505.   procedure check_status; { used to read status of nrd 535 }
  506.   var ch:char;
  507.       s1:string;
  508.       dummy:integer;
  509.   begin
  510.     comreadln(COM_NRD,s);
  511.     s:='I'+s;
  512.     with receiverstat do
  513.       begin
  514.         { get attenuator status }
  515.         ch:=s[2];
  516.         case ch of
  517.           '0': attenuator:=NO;
  518.           '1': attenuator:=YES;
  519.           else attenuator:=YES; { error condition }
  520.         end;
  521.  
  522.         { get bandwidth }
  523.         ch:=s[3];
  524.         case ch of
  525.           '0': bandwidth:=WIDE;
  526.           '1': bandwidth:=INTER;
  527.           '2': bandwidth:=NARR;
  528.           '3': bandwidth:=AUX;
  529.           else bandwidth:=AUX; { error condition }
  530.         end;
  531.  
  532.         { get receiver mode }
  533.         ch:=s[4];
  534.         case ch of
  535.           '0': mode:=RTTY;
  536.           '1': mode:=CW;
  537.           '2': mode:=USB;
  538.           '3': mode:=LSB;
  539.           '4': mode:=AM;
  540.           '5': mode:=FM;
  541.           '6': mode:=FAX;
  542.           '7': mode:=ECSS_USB;
  543.           '8': mode:=ECSS_LSB;
  544.           else mode:=FM; { error condition }
  545.         end;
  546.  
  547.         { get frequency }
  548.         s1:=copy(s,5,8);
  549.         val(s1,frequency,dummy);
  550.         frequency:=frequency / 1000.0;
  551.  
  552.         { get agc setting }
  553.         ch:=s[13];
  554.         case ch of
  555.           '0': agc:=SLOW;
  556.           '1': agc:=FAST;
  557.           '2': agc:=OFF;
  558.           else agc:=OFF; { error condition }
  559.         end;
  560.       end;
  561.   end;
  562.  
  563.   procedure remote_on;
  564.   { enable remote control of radio, get receiver status }
  565.   const ECHO   = FALSE;
  566.         STRLEN = 40;
  567.   var s,s1:string;
  568.       dummy:integer;
  569.       ch:char;
  570.  
  571.     procedure initiate_remote; { send remote on string }
  572.     begin
  573.       write_com(COM_NRD,'H1');      { enable receiver remote mode }
  574.     end;
  575.  
  576.     procedure check_serial_port(var s1:string);
  577.  
  578.     { This is a bizarre procedure to minimize program hanging in the event
  579.       that the radio is left off or the serial port is selected to another
  580.       device.  It uses an algorithm that assumes that no response to the
  581.       remote command is an indication of error as is receiving a response
  582.       back that does not begin in "C".  The latter can happen if the serial
  583.       port is attached to a modem for example...}
  584.  
  585.       procedure check_response(ch:char; var s1:string);
  586.       var ch1:char;
  587.       begin
  588.         if ch = 'C' then { all is (assumed) ok }
  589.           begin
  590.             s1:=' '; s1[1]:=ch;
  591.           end
  592.         else
  593.           begin
  594.             writeln(output,
  595.   'Improper response from radio --- check connections and re-run program');
  596.             writeln(output,'Hit any key to continue');
  597.             repeat until keypressed;
  598.             ch1:=readkey;
  599.             halt;
  600.           end;
  601.       end;
  602.  
  603.     var ch, ch1:char;
  604.     begin
  605.       if com_nrd = 0 then { abort check }
  606.         begin
  607.           s1:='';
  608.           exit;
  609.         end;
  610.       if not async_buffer_check(ch) then { something is wrong }
  611.         begin
  612.           delay(250); { just in case }
  613.           if not async_buffer_check(ch) then { hung for sure }
  614.             begin
  615.               writeln(output,
  616.               'No response from receiver.  Correct and hit any key');
  617.               repeat until keypressed;
  618.               ch1:=readkey;
  619.               s1:='';
  620.               initiate_remote;
  621.             end
  622.           else check_response(ch,s1);
  623.         end
  624.       else check_response(ch,s1);
  625.     end;
  626.  
  627.   begin
  628.     if com_nrd > 0 then while async_buffer_check(ch) do;
  629.             { nrd sometimes leaves stuff behind }
  630.     initiate_remote;
  631.     if radio_type = 535 then exit
  632.     else
  633.       begin
  634.         check_serial_port(s1); { will return 1st char in s1 }
  635.         with receiverstat do
  636.           begin
  637.             { get channel }
  638.             comreadln(COM_NRD,s);
  639.             s:=s1 + s;
  640.             delete(s,1,1); { remove "C" }
  641.             val(s,channel,dummy);
  642.  
  643.             { get receiver mode }
  644.             comreadln(COM_NRD,s);
  645.             ch:=s[2];
  646.             case ch of
  647.               '0': mode:=RTTY;
  648.               '1': mode:=CW;
  649.               '2': mode:=USB;
  650.               '3': mode:=LSB;
  651.               '4': mode:=AM;
  652.               '5': mode:=FM;
  653.               '6': mode:=FAX;
  654.               else mode:=FM; { error condition }
  655.             end;
  656.  
  657.             { get agc setting }
  658.             comreadln(COM_NRD,s);
  659.             ch:=s[2];
  660.             case ch of
  661.               '0': agc:=SLOW;
  662.               '1': agc:=FAST;
  663.               '2': agc:=OFF;
  664.               else agc:=OFF; { error condition }
  665.             end;
  666.  
  667.             { get attenuator status }
  668.             comreadln(COM_NRD,s);
  669.             ch:=s[2];
  670.             case ch of
  671.               '0': attenuator:=NO;
  672.               '1': attenuator:=YES;
  673.               else attenuator:=YES; { error condition }
  674.             end;
  675.  
  676.             { get bandwidth }
  677.             comreadln(COM_NRD,s);
  678.             ch:=s[2];
  679.             case ch of
  680.               '0': bandwidth:=WIDE;
  681.               '1': bandwidth:=INTER;
  682.               '2': bandwidth:=NARR;
  683.               '3': bandwidth:=AUX;
  684.               else bandwidth:=AUX; { error condition }
  685.             end;
  686.  
  687.             { get frequency }
  688.             comreadln(COM_NRD,s);
  689.             delete(s,1,1); { get rid of "F" }
  690.             val(s,frequency,dummy);
  691.             frequency:=frequency / 100.0;
  692.           end;
  693.       end;
  694.   end;
  695.  
  696.   procedure remote_off;
  697.   begin
  698.     write_com(COM_NRD,'H0'); { disable receiver remote mode }
  699.     delay(dly);
  700.   end;
  701.  
  702.   procedure toggle_remote; { unlock radio }
  703.   var ch:char;
  704.       s:string;
  705.   begin
  706.     write_com(COM_NRD,'I0');
  707.     write_com(COM_NRD,'I1');
  708.     delay(200);
  709.     if async_buffer_check(ch) then check_status(s);
  710.   end;
  711.  
  712.   procedure set_freq;
  713.   var s:string;
  714.   begin
  715.     str(frequency:8:2,s);
  716.     while s[1] = ' ' do delete(s,1,1);
  717.     while length(s) < 9 do s:=concat('0',s);
  718.     s:=concat('F',s);
  719.     delete(s,8,1); { remove "." }
  720.     if radio_type = 535 then
  721.       begin
  722.         delete(s,2,1);
  723.         s:=s + '0';
  724.       end;
  725.     write_com(COM_NRD,s);
  726.     if radio_type = 525 then comreadln(COM_NRD,s);
  727.   end;
  728.  
  729.   procedure set_mode;
  730.   var ch:char;
  731.       s:string;
  732.   begin
  733.     case mode of
  734.       RTTY:     s:='0';
  735.       CW:       s:='1';
  736.       USB:      s:='2';
  737.       LSB:      s:='3';
  738.       AM:       s:='4';
  739.       FM:       s:='5';
  740.       FAX:      s:='6';
  741.       ECSS_USB: s:='7';
  742.       ECSS_LSB: s:='8';
  743.     end;
  744.     s:=concat('D',s);
  745.     write_com(COM_NRD,s);
  746.     if radio_type = 525 then comreadln(COM_NRD,s);
  747.   end;
  748.  
  749.   procedure set_bandwidth;
  750.   var ch:char;
  751.       s:string;
  752.   begin
  753.     case bandwidth of
  754.       WIDE:  s:='0';
  755.       INTER: s:='1';
  756.       NARR:  s:='2';
  757.       AUX:   s:='3';
  758.     end;
  759.     s:=concat('B',s);
  760.     write_com(COM_NRD,s);
  761.     if radio_type = 525 then comreadln(COM_NRD,s);
  762.   end;
  763.  
  764.   procedure set_agc;
  765.   var ch:char;
  766.       s:string;
  767.   begin
  768.     case agc of
  769.       SLOW:  s:='0';
  770.       FAST:  s:='1';
  771.       OFF:   s:='2';
  772.     end;
  773.     s:=concat('G',s);
  774.     write_com(COM_NRD,s);
  775.     comreadln(COM_NRD,s);
  776.   end;
  777.  
  778.   procedure set_attenuator;
  779.   var ch:char;
  780.       s:string;
  781.   begin
  782.     case attenuator of
  783.       NO:  s:='0';
  784.       YES: s:='1';
  785.     end;
  786.     s:=concat('A',s);
  787.     write_com(COM_NRD,s);
  788.     comreadln(COM_NRD,s);
  789.   end;
  790.  
  791.   procedure set_bwc;
  792.   begin
  793.     write_com(COM_NRD,'W'+ s); { set bw to "s" Hz }
  794.   end;
  795.  
  796.   procedure set_tuning_rate;
  797.   begin
  798.     write_com(COM_NRD,'V' + s); { control tuning increment }
  799.   end;
  800.  
  801.   procedure set_auto_tune;
  802.   begin
  803.     write_com(COM_NRD,'Y' + s);
  804.   end;
  805.  
  806.   procedure set_all; { used to set all parameters for an NRD535 }
  807.   var s,s1:string;
  808.   begin
  809.     s:='S';
  810.     str(channel,s1);
  811.     while length(s1) < 3 do s1:='0' + s1;
  812.     s:=s + s1;
  813.     case attenuator of
  814.       NO: s:=s + '0';
  815.       YES:s:=s + '1';
  816.     end;
  817.     case bandwidth of
  818.       WIDE:  s:=s + '0';
  819.       INTER: s:=s + '1';
  820.       NARR:  s:=s + '2';
  821.       AUX:   s:=s + '3';
  822.     end;
  823.     case mode of
  824.       RTTY:     s:=s + '0';
  825.       CW:       s:=s + '1';
  826.       USB:      s:=s + '2';
  827.       LSB:      s:=s + '3';
  828.       AM:       s:=s + '4';
  829.       FM:       s:=s + '5';
  830.       FAX:      s:=s + '6';
  831.       ECSS_USB: s:=s + '7';
  832.       ECSS_LSB: s:=s + '8';
  833.     end;
  834.     str(frequency:8:2,s1);
  835.     while s1[1] = ' ' do delete(s1,1,1);
  836.     while length(s1) < 8 do s1:=concat('0',s1);
  837.     delete(s1,6,1); { remove "." }
  838.     s:=s + s1 + '00';
  839.     write_com(COM_NRD,s);
  840.     delay(REMOTE_DLY);
  841.   end;
  842.  
  843.   procedure information_mode_on;
  844.   begin
  845.     write_com(COM_NRD,'I1');
  846.   end;
  847.  
  848.   procedure information_mode_off;
  849.   begin
  850.     write_com(COM_NRD,'I0'); { unlock radio }
  851.   end;
  852.  
  853.   procedure read_s_meter;
  854.   begin
  855.     write_com(COM_NRD,'M');  { request s-meter reading }
  856.   end;
  857.  
  858.   function get_s_reading;
  859.   var s,s1:string;
  860.       ch:char;
  861.       dummy,reading:integer;
  862.       freq:real;
  863.   begin
  864.     repeat
  865.       read_s_meter;  { request s-meter reading }
  866.       comreadln(COM_NRD,s);
  867.       ch:=s[1];
  868.       delete(s,1,1);
  869.       if ch = 'M' then val(s,reading,dummy);
  870.     until ch = 'M';
  871.     get_s_reading:=reading;
  872.   end;
  873.  
  874.  
  875.   procedure check_s_meter;
  876.   var s:string;
  877.       s_reading, dummy:integer;
  878.       ch:char;
  879.       
  880.   begin
  881.     reading:=1;
  882.     remote_on;
  883.     if async_buffer_check(ch) then comreadln(COM_NRD,s); { discard }
  884.     s_reading:=get_s_reading;
  885.     remote_off(0);
  886.     information_mode_on;
  887.     case s_reading of { map to dB }
  888.       255..245: reading:=-9;
  889.       244..233: reading:=-8;
  890.       232..221: reading:=-7;
  891.       220..209: reading:=-6;
  892.       208..198: reading:=-5;
  893.       197..186: reading:=-4;
  894.       185..174: reading:=-3;
  895.       173..163: reading:=-2;
  896.       162..155: reading:=-1;
  897.       154..163: reading:=1;
  898.       142..155: reading:=2;
  899.       133..143: reading:=3;
  900.       124..134: reading:=4;
  901.       118..125: reading:=5;
  902.       112..119: reading:=6;
  903.       108..113: reading:=7;
  904.       103..109: reading:=8;
  905.        99..104: reading:=9;
  906.        92.. 98: reading:=10;
  907.        90.. 91: reading:=15;
  908.        87.. 89: reading:=20;
  909.        84.. 86: reading:=25;
  910.        81.. 83: reading:=30;
  911.        78.. 80: reading:=35;
  912.        75.. 77: reading:=40;
  913.        73.. 74: reading:=45;
  914.        72.. 72: reading:=50;
  915.        70.. 71: reading:=55;
  916.         0.. 69: reading:=60;
  917.         else reading:=1;
  918.     end;
  919.   end;
  920.  
  921.   procedure init; { initialize port address, file path and existence of MAP }
  922.   const CONFIG_PATH = 'CONFIG.DAT';
  923.   var buf:file;
  924.       configdat:configtype;
  925.       num:integer;
  926.  
  927.     procedure open_config(var rslt:integer);
  928.     var ch:char;
  929.         ok,dummy:boolean;
  930.         hour,minute,sec,sec100:word;
  931.         s:string;
  932.     begin
  933.       assign(buf,CONFIG_PATH);
  934.       repeat
  935.         reset(buf,sizeof(configdat));
  936.         rslt:=ioresult;
  937.         if rslt = FILE_NOT_FOUND then
  938.           begin
  939.             repeat
  940.               home;
  941.               writea(LIGHTGREEN, FOREGROUND);
  942.               writeln(output,
  943.   'System could not find Config.dat file.  Please answer these questions');
  944.               writeln(output,
  945.   'about your system and Config.dat will be created for you...');
  946.               entnum(0,10,num,ok,dummy,
  947.                    'your com port (eg 1 for COM1:, 0 for demo):');
  948.               if num in [0..4] then configdat.com_port:=num;
  949.               if not ok then halt;
  950.             until num in [0..4];
  951.             writeln(output);
  952.             writea(LIGHTGREEN, FOREGROUND);
  953.             repeat
  954.               write(output,'Enter receiver type (525 or 535):');
  955.               readln(input,s);
  956.             until (s = '525') or (s = '535');
  957.             if s = '525' then configdat.receiver_type:=525
  958.                          else configdat.receiver_type:=535;
  959.             if configdat.receiver_type = 525 then
  960.               begin
  961.                 write(output,'Do you have a KIWA MAP unit? (y=yes):');
  962.                 read(input,ch);
  963.                 configdat.has_map:=ch in ['y','Y'];
  964.                 writeln(output);
  965.               end
  966.             else configdat.has_map:=FALSE;
  967.             writeln(output,
  968. 'Now we will adjust the time offset so time is referenced to GMT.');
  969.             writeln(output,
  970. 'Enter the hour only (not minutes) in GMT (eg if GMT = 16:47, enter 16.');
  971.             entnum(0,17,num,ok,dummy,'the');
  972.             if not ok then halt;
  973.             gettime(hour,minute,sec,sec100);
  974.             configdat.time_offset:=num - hour;
  975.             rewrite(buf,sizeof(configdat));
  976.             blockwrite(buf,configdat,1);
  977.             close(buf);
  978.             reset(buf,sizeof(configdat));
  979.             rslt:=ioresult;
  980.           end;
  981.         hndlerr(FALSE,ch,rslt);
  982.       until (rslt = 0) or (ch = KEYINFO.ESCKEY);
  983.     end;
  984.  
  985.     procedure get_config;
  986.     var ch:char;
  987.         rslt:integer;
  988.     begin
  989.       open_config(rslt);
  990.       if rslt = 0 then
  991.         begin
  992.           blockread(buf,configdat,1);
  993.           rslt:=ioresult;
  994.           hndlerr(FALSE,ch,rslt);
  995.         end;
  996.       com_nrd:=configdat.com_port;
  997.       has_map:=configdat.has_map;
  998.       radio_type:=configdat.receiver_type;
  999.       gmt_offset:=configdat.time_offset;
  1000.       close(buf);
  1001.     end;
  1002.  
  1003.   begin
  1004.     get_config;
  1005.   end;
  1006.  
  1007. begin
  1008.   init
  1009. end.
  1010.  
  1011.